home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / graphics / mfpic / mfpic / graphbase.mf < prev    next >
Text File  |  1994-07-11  |  10KB  |  642 lines
  1. %%%
  2. %%%  File: graphbase.mf
  3. %%%
  4.  
  5. mode_setup;
  6. message "mfpic 0.2.5 --- graphbase version 0.2.5.1 --- 12 July 1994";
  7.  
  8. %set up local environment
  9.  
  10. def mfpicenv =
  11. begingroup
  12.  
  13. % miscellaneous utilities
  14.  
  15. save floorpair;
  16.  
  17. vardef floorpair(expr p) =
  18.  (floor (xpart p), floor (ypart p))
  19. enddef;
  20.  
  21. save ceilingpair;
  22.  
  23. vardef ceilingpair(expr p) =
  24.  (ceiling (xpart p), ceiling (ypart p))
  25. enddef;
  26.  
  27. save minpair, p,x,y;
  28.  
  29. vardef minpair(expr u)(text t) =
  30.  pair p;  numeric x, y;
  31.  p:=u;
  32.  for q=t:
  33.   x:=min(xpart p, xpart q);
  34.   y:=min(ypart p, ypart q);
  35.   p:=(x,y);
  36.  endfor;
  37.  p
  38. enddef;
  39.  
  40. save maxpair, p,x,y;
  41.  
  42. vardef maxpair(expr u)(text t) =
  43.  pair p;  numeric x, y;
  44.  p:=u;
  45.  for q=t:
  46.   x:=max(xpart p, xpart q);
  47.   y:=max(ypart p, ypart q);
  48.   p:=(x,y);
  49.  endfor;
  50.  p
  51. enddef;
  52.  
  53. % setup
  54.  
  55. save bounds,
  56.   xneg,xpos,yneg,ypos;
  57.  
  58. def bounds(expr a,b,c,d) = 
  59.  xneg:=a; 
  60.  xpos:=b; 
  61.  yneg:=c; 
  62.  ypos:=d; 
  63. enddef;
  64.  
  65. % conversion
  66.  
  67. save xconv;
  68.  
  69. def xconv(expr xvalue) = 
  70.  ((xvalue-xneg)/(xpos-xneg))*w 
  71. enddef;
  72.  
  73. save unxconv;
  74.  
  75. def unxconv(expr pvalue) = 
  76.  ((pvalue/w)*(xpos-xneg)) 
  77. enddef;
  78.  
  79. save yconv;
  80.  
  81. def yconv(expr yvalue) = 
  82.  ((yvalue-yneg)/(ypos-yneg))*h 
  83. enddef;
  84.  
  85. save ztr;
  86.  
  87. transform ztr;
  88.  
  89. save setztr;
  90.  
  91. def setztr =
  92.  ztr:=identity
  93.  shifted -(xneg,yneg) 
  94.  xscaled (w/(xpos-xneg))
  95.  yscaled (h/(ypos-yneg));
  96. enddef;
  97.  
  98. % pen width
  99. % in pixel coordinates
  100.  
  101. save penwd;
  102.  
  103. newinternal penwd;
  104.  
  105. % arrowheads
  106. % in pixel coordinates
  107.  
  108. save hdwdr, hdten;
  109.  
  110. newinternal hdwdr, hdten;
  111.  
  112. save head, p,side;
  113.  
  114. def head(expr front, back, width, t) =
  115.  pair p[], side;
  116.  side := (width/2) * 
  117.    ((front-back) rotated 90);
  118.  p1 := back + side;
  119.  p2 := back - side;
  120.  draw front{back-front}..tension t..p1;
  121.  draw front{back-front}..tension t..p2;
  122. enddef;
  123.  
  124. save headpath, p;
  125.  
  126. def headpath(expr f,hlen)=
  127.  pair p[];
  128.  p2:=point infinity of f; 
  129.  p1:=direction infinity of f;
  130.  if p1<>(0,0):
  131.   head(p2,p2-(hlen*unitvector(p1)),
  132.     hdwdr,hdten);
  133.  fi;
  134. enddef;
  135.  
  136. % shading routine
  137. % in pixel coordinates
  138.  
  139. save onedot;
  140.  
  141. def onedot(expr p)(suffix v) =
  142.  addto v doublepath p
  143.    withpen currentpen; 
  144. enddef;
  145.  
  146. save clip;
  147.  
  148. vardef clip(expr f)(suffix v) =
  149.  save vt;
  150.  picture vt;
  151.  vt:=v;
  152.  cull vt keeping (1,infinity);
  153.  addto vt contour f;
  154.  cull vt keeping (2,infinity);
  155.  vt
  156. enddef;
  157.  
  158. save shadepath, v,p,ll,ur,
  159.   mn,m,n,twosp;
  160.  
  161. def shadepath(expr sp,f) =
  162.  picture v;
  163.  pair p[], ll, ur, mn;
  164.  if not cycle f: ;
  165.  elseif sp<=0: fill f; 
  166.  else: 
  167.   ur:=ll:=point 0 of f; 
  168.   for i:=0 upto length f:
  169.    p0:=point i of f; 
  170.    p1:=precontrol i of f; 
  171.    p2:=postcontrol i of f;
  172.    ll:=minpair(ll, p0, p1, p2);
  173.    ur:=maxpair(ur, p0, p1, p2);
  174.   endfor; 
  175.   ll:=sp*(ceilingpair(ll/sp));
  176.   mn:=floorpair((ur-ll)/sp);
  177.   m:=xpart mn;
  178.   n:=ypart mn;
  179.   twosp:=2*sp;
  180.   v:=nullpicture;
  181.   p2:=ll;
  182.   for i:=0 upto m: 
  183.    p3:=p2 if odd i: +(0,sp) fi;
  184.    for j:=0 upto n:
  185.     if (not odd (i+j)):
  186.      onedot(p3,v);
  187.      p3:=p3+(0,twosp);
  188.     fi;
  189.    endfor;
  190.    p2:=p2+(sp,0);
  191.   endfor; 
  192.   addto currentpicture 
  193.     also clip(f,v);
  194.  fi;
  195. enddef;
  196.  
  197. % * rest of macros start in graphing 
  198. % coordinates but convert to pixel 
  199. % to draw
  200. % * variables ending in ".px" 
  201. % converted to pixel
  202. % * exceptions are the TeX dimensions
  203. % here called:
  204. % ptwd, hlen, dlen, slen, len, sp
  205. % all of which are in pixel coordinates
  206. % * macros beginning with "mk" operate
  207. % entirely in graphing coordinates
  208.  
  209. % general path construction
  210.  
  211. save mkpath;
  212.  
  213. def mkpath(expr smooth, cyclic, n)
  214.   (suffix pts) =
  215.  if smooth:
  216.   if cyclic:
  217.    pts[1]{pts[2]-pts[n]}
  218.   else:
  219.    pts[1]
  220.   fi
  221.   for i:=2 upto n-1:
  222.    ..pts[i]{pts[i+1]-pts[i-1]}
  223.   endfor
  224.   if cyclic:
  225.    ..pts[n]{pts[1]-pts[n-1]}..cycle
  226.   else:
  227.    ..pts[n]
  228.   fi
  229.  else:
  230.   for i:=1 upto n-1:
  231.     pts[i] --
  232.   endfor
  233.   pts[n]
  234.   if cyclic:
  235.    -- cycle
  236.   fi
  237.  fi
  238. enddef;
  239.  
  240. % points, lines, and arrows
  241.  
  242. save pointd, p;
  243.  
  244. def pointd(expr a,ptwd) = 
  245.  pair p.px;
  246.  p.px:=a transformed ztr;
  247.  fill fullcircle scaled ptwd shifted p.px; 
  248. enddef;
  249.  
  250. save line;
  251.  
  252. def line(expr a,b) = 
  253.  draw (a..b) transformed ztr; 
  254. enddef;
  255.  
  256. save arrow, f;
  257.  
  258. def arrow(expr tl,hd,hlen) =
  259.  path f.px;
  260.  f.px:= (tl..hd) transformed ztr; 
  261.  draw f.px;
  262.  headpath(f.px,hlen);
  263. enddef;
  264.  
  265. save dottedline, p,
  266.   v,l,delta,n;
  267.  
  268. def dottedline(expr a,b,dlen,slen) =
  269.  pair p.px[];
  270.  pair v.px;
  271.  p.px1:=a transformed ztr;
  272.  p.px3:=b transformed ztr;
  273.  l.px:=length(p.px3-p.px1); 
  274.  if (l.px<=2*dlen) or 
  275.    (dlen<0) or (slen<0): 
  276.   draw p.px1..p.px3; 
  277.  else: 
  278.   v.px:=unitvector(p.px3-p.px1);
  279.   n:=floor((l.px+slen-dlen)/(dlen+slen));
  280.   delta:=((l.px-dlen)/n)-(dlen+slen);
  281.   for i:=1 upto n:
  282.    p.px2:=p.px1+(dlen*v.px); 
  283.    draw p.px1..p.px2; 
  284.    p.px1:=p.px2+((slen+delta)*v.px);
  285.   endfor; 
  286.   draw p.px1..p.px3;
  287.  fi;
  288. enddef;
  289.  
  290. save dottedarrow;
  291.  
  292. def dottedarrow(expr tl,hd,dlen,
  293.   slen,hlen) =
  294.  dottedline(tl,hd,dlen,slen); 
  295.  headpath((tl..hd) transformed ztr,hlen);
  296. enddef;
  297.  
  298. % axes and axis marks
  299.  
  300. save axes;
  301.  
  302. def axes(expr hlen) =
  303.  arrow((0,yneg),(0,ypos),hlen); 
  304.  arrow((xneg,0),(xpos,0),hlen);
  305. enddef;
  306.  
  307. save xmarks;
  308.  
  309. def xmarks(expr len)(text t) =
  310.  for a=t: 
  311.   draw (xconv(a),yconv(0)-(len/2))..
  312.     (xconv(a),yconv(0)+(len/2)); 
  313.  endfor; 
  314. enddef;
  315.  
  316. save ymarks;
  317.  
  318. def ymarks(expr len)(text t) =
  319.  for a=t: 
  320.   draw (xconv(0)-(len/2),yconv(a))..
  321.     (xconv(0)+(len/2),yconv(a)); 
  322.  endfor; 
  323. enddef;
  324.  
  325. % polygons
  326.  
  327. save mkrect;
  328.  
  329. def mkrect(expr ll,ur) =
  330.  ll--(xpart ll,ypart ur)--
  331.    ur--(xpart ur,ypart ll)--cycle
  332. enddef;
  333.  
  334. save rect;
  335.  
  336. def rect(expr ll,ur) =
  337.  draw (mkrect(ll,ur)) transformed ztr;
  338. enddef;
  339.  
  340. save dottedrect;
  341.  
  342. def dottedrect(expr ll,ur,dlen,slen) =
  343.  dottedline(ll,(xpart ll,ypart ur),
  344.    dlen,slen);
  345.  dottedline((xpart ll,ypart ur),ur,
  346.    dlen,slen);
  347.  dottedline(ur,(xpart ur,ypart ll),
  348.    dlen,slen);
  349.  dottedline((xpart ur,ypart ll),ll,
  350.    dlen,slen);
  351. enddef;
  352.  
  353. save block;
  354.  
  355. def block(expr ll,ur) =
  356.  fill (mkrect(ll,ur)) transformed ztr;
  357. enddef;
  358.  
  359. save rectshade;
  360.  
  361. def rectshade(expr sp,ll,ur) =
  362.  path f.px; 
  363.  f.px:=(mkrect(ll,ur)) transformed ztr;
  364.  shadepath(sp,f.px);
  365. enddef;
  366.  
  367. % circles and ellipses
  368.  
  369. save mkellipse;
  370.  
  371. vardef mkellipse(expr center,radx,rady,
  372.   angle) =
  373.  save t;
  374.  transform t; 
  375.  t:=identity xscaled (2*radx) 
  376.    yscaled (2*rady) rotated angle 
  377.    shifted center;
  378.  fullcircle transformed t
  379. enddef;
  380.  
  381. save ellipse;
  382.  
  383. def ellipse(expr center,radx,rady,
  384.   angle) =
  385.  draw 
  386.    (mkellipse(center,radx,rady,angle))
  387.    transformed ztr;
  388. enddef;
  389.  
  390. save circle;
  391.  
  392. def circle(expr center,rad) =
  393.  ellipse(center,rad,rad,0);
  394. enddef;
  395.  
  396. save ellshade ,f;
  397.  
  398. def ellshade (expr sp, center, 
  399.   radx, rady, angle) =
  400.  path f.px;
  401.  f.px:=
  402.    (mkellipse(center,radx,rady,angle))
  403.    transformed ztr;
  404.  shadepath(sp,f.px);
  405. enddef;
  406.  
  407. save circshade;
  408.  
  409. def circshade(expr sp, center,rad) =
  410.  ellshade(sp,center,rad,rad,0);
  411. enddef;
  412.  
  413. % circular arcs
  414.  
  415. save mkarc;
  416.  
  417. vardef mkarc(expr center,from,sweep)=
  418.  save p,f,n,i;
  419.  pair p[];
  420.  path f;
  421.  if sweep=0: f:=from;
  422.  else:
  423.   n:=floor(abs(sweep)/45)+1;
  424.   if n<3: n:=3; fi;
  425.   theta:=sweep/(n-1);
  426.   p1:=from; 
  427.   for i:=2 upto n:
  428.    p[i]:=p[i-1] 
  429.      rotatedabout (center,theta);
  430.   endfor;
  431.   f:=mkpath(true,false,n,p)
  432.  fi;
  433.  f
  434. enddef;
  435.  
  436. save arccenter;
  437.  
  438. vardef arccenter(expr from,to,sweep)=
  439.  save midpt, disp;
  440.  pair midpt;
  441.  midpt:=(0.5)[from,to];
  442.  disp:=
  443.    if ((sweep mod 360)=0):
  444.     0
  445.    else:
  446.     cosd(sweep/2)/sind(sweep/2)
  447.    fi;
  448.  midpt+(disp*((to-from) rotated 90)/2)
  449. enddef;
  450.  
  451. save arc, center;
  452.  
  453. def arc(expr from,to,sweep) =
  454.  pair center;
  455.  center:=arccenter(from,to,sweep);
  456.  draw (mkarc(center, from, sweep)) 
  457.     transformed ztr;
  458. enddef;
  459.  
  460. save arcarrow, center,f;
  461.  
  462. def arcarrow(expr hlen,from,to,sweep) =
  463.  pair center;
  464.  path f.px; 
  465.  center:=arccenter(from,to,sweep);
  466.  f.px:=(mkarc(center, from, sweep))
  467.    transformed ztr; 
  468.  draw f.px;
  469.  headpath(f.px,hlen);
  470. enddef;
  471.  
  472. save arcshade, center,f;
  473.  
  474. def arcshade(expr sp,from,to,sweep) =
  475.  pair center;
  476.  path f.px; 
  477.  center:=arccenter(from,to,sweep);
  478.  f.px:=(mkarc(center,from,sweep)--cycle)
  479.    transformed ztr;
  480.  shadepath(sp,f.px);
  481. enddef;
  482.  
  483. % modified polar coordinates
  484.  
  485. save linedir, p;
  486.  
  487. def linedir(expr a,theta,len) =
  488.  pair p;
  489.  p:=a+len*(dir theta);
  490.  draw (a..p) transformed ztr;
  491. enddef;
  492.  
  493. save arrowdir, p,f;
  494.  
  495. def arrowdir(expr hlen,a,theta,len) =
  496.  pair p;
  497.  path f.px;
  498.  p:=a+len*(dir theta);
  499.  f.px:= (a..p) transformed ztr;
  500.  draw f.px;
  501.  headpath(f.px,hlen);
  502. enddef;
  503.  
  504. save arcth, from;
  505.  
  506. def arcth(expr center,
  507.   frtheta,totheta,rad) =
  508.  pair from;
  509.  from:=center+rad*(dir frtheta);
  510.  draw (mkarc(center,from,
  511.    totheta-frtheta))
  512.    transformed ztr;
  513. enddef;
  514.  
  515. save arctharrow, from,f;
  516.  
  517. def arctharrow(expr hlen,center, 
  518.   frtheta,totheta,rad) =
  519.  pair from;
  520.  path f.px;
  521.  from:=center+rad*(dir frtheta);
  522.  f.px:= (mkarc(center,from,
  523.    totheta-frtheta))
  524.    transformed ztr;
  525.  draw f.px;
  526.  headpath(f.px,hlen);
  527. enddef;
  528.  
  529. save wedgeshade, from,f;
  530.  
  531. def wedgeshade(expr sp,center, 
  532.   frtheta,totheta,rad) =
  533.  pair from;
  534.  path f.px;
  535.  from:=center+rad*(dir frtheta);
  536.  f.px:=(center--
  537.    mkarc(center,from,totheta-frtheta)
  538.    --cycle) transformed ztr;
  539.  shadepath(sp, f.px);
  540. enddef;
  541.  
  542. % curves
  543.  
  544. save mkcurve;
  545.  
  546. vardef mkcurve(expr smooth,cyclic)
  547.   (text t)=
  548.  save i,p,a;
  549.  i:=0; 
  550.  pair p[];
  551.  for a=t: 
  552.   p[incr i]:=a; 
  553.  endfor; 
  554.  mkpath(smooth,cyclic,i,p)
  555. enddef;
  556.  
  557. save curve;
  558.  
  559. def curve(expr smooth,cyclic)
  560.   (text t) =
  561.  draw (mkcurve(smooth,cyclic,t))
  562.    transformed ztr; 
  563. enddef;
  564.  
  565. save curvedarrow, f;
  566.  
  567. def curvedarrow(expr smooth,hlen)
  568.   (text t) =
  569.  path f.px;
  570.  f.px:=(mkcurve(smooth,false,t))
  571.    transformed ztr; 
  572.  draw f.px;
  573.  headpath(f.px,hlen);
  574. enddef;
  575.  
  576. % cyclic curves
  577.  
  578. save cycleshade, f;
  579.  
  580. def cycleshade(expr sp,smooth)(text t) =
  581.  path f.px;
  582.  f.px:=mkcurve(smooth,true,t)
  583.    transformed ztr;
  584.  shadepath(sp,f.px);
  585. enddef;
  586.  
  587. % functions
  588.  
  589. save mkfcn;
  590.  
  591. vardef mkfcn(expr smooth,bmin,bmax,bst)
  592.   (suffix bv)(text fcnpr)=
  593.  save p,i;
  594.  pair p[];
  595.  i:=0;
  596.  for bv:=bmin step bst 
  597.    until bmax+(bst/2):
  598.   p[incr i]:=fcnpr; 
  599.  endfor;
  600.  mkpath(smooth,false,i,p)
  601. enddef;
  602.  
  603. save function;
  604.  
  605. def function(expr smooth,xmin,xmax,st)
  606.   (text fx) =
  607.  draw (mkfcn(smooth,xmin,xmax,st,
  608.    x,(x,fx)))
  609.    transformed ztr; 
  610. enddef;
  611.  
  612. save parafcn;
  613.  
  614. def parafcn(expr smooth,tmin,tmax,st)
  615.   (text ft) =
  616.  draw (mkfcn(smooth,tmin,tmax,st,
  617.    t,ft))
  618.    transformed ztr; 
  619. enddef;
  620.  
  621. save shadefcn, f,st;
  622.  
  623. def shadefcn(expr sp, xmin, xmax)
  624.   (text fcni)(text fcnii) =
  625.  path f.px; 
  626.  st:=unxconv(sp);
  627.  f.px:=(mkfcn(false,xmin,xmax,st,
  628.    x,(x,fcni))
  629.    --reverse
  630.    mkfcn(false,xmin,xmax,st,
  631.    x,(x,fcnii))
  632.    --cycle) transformed ztr;
  633.  shadepath(sp,f.px);
  634. enddef;
  635.  
  636. enddef;  % mfpicenv
  637.  
  638. def endmfpicenv =
  639.  endgroup;
  640. enddef;
  641.  
  642.